(** Module IL
 *
 *  Author: Jk
 *)

module Option(X:HTMLView.Element) = struct
  type t = X.t option
  let toHTML = function 
    None -> HTMLView.bold "None" 
   |Some x -> HTMLView.bold "Some " ^ X.toHTML x
end

module Source = struct
  
(** Source text representation type
    (repr , ( start,end))
*)
type t = string * (int * int ) 

let toString (r,_:t):string = r
let toHTML = toString

end

module Production = struct
  type ('patt,'expr) elem = {
     omit:bool
     ;rule:('patt,'expr) t
     ;binding:'patt option
     ;checker:'expr option
  } 
 and
  ('patt,'expr) t =    
    PAlt of ('patt,'expr) t * ('patt,'expr) t
   |PSeq of ('patt,'expr) elem list * 'expr option
   |PToken of Source.t
   |PRef of Source.t * 'expr option
   |PMany of ('patt,'expr) t
   |PMetaRef of Source.t * 'expr option * 'expr list
   |PSome of ('patt,'expr) t
   |POpt of ('patt,'expr) t
   |PLiteral of Source.t

  let rec toHTML = function
   PAlt (l,r) -> "PAlt" ^ toHTML l ^ toHTML r
  |PSeq _  -> "*Wow! Seq!*"
  |PToken t | PLiteral t -> Source.toHTML t
  |PMetaRef _ -> "*PMetaRef*"
  |PRef (t, a) -> Source.toHTML t 
                ^ HTMLView.italic ( let module O = Option(Source) in O.toHTML a ) 
  |PMany r | PSome r | POpt r -> toHTML r
end

module Rule = struct
  type ('patt,'expr) t = { 
           name  : string
          ;args  : 'patt list 
          ;body  : ('patt,'expr) Production.t
          ;public: bool
          ;metaArgs: 'patt list
  }

end

module Grammar = struct
  type ('patt,'expr) t = ('patt,'expr) Rule.t list 
end

module Definition = struct
  type ('patt,'expr) t = { 
          head:'expr option
        ; grammar: ('patt,'expr) Grammar.t
        ; foot:'expr option
  }
end

(*
module UseGraphs = 
  struct
  
    module GramAsDi = 
      struct

	open Types

	module NodeInfo = 
	  struct 
        type t = 
		(string
		   , string option
		   , ( (string option,string) ruleStructure
		         ,string option
		      ) rule
		) ruleDecl
        let toString x = x.name 
     end                             

     module EdgeInfo = 
       struct
         type t = string * string
         let toString (a,b) = Printf.sprintf "%s -> %s" a b 
       end

     module D = Digraph.Make(NodeInfo)(EdgeInfo)
     module NameSet = Set.Make(String)

     let initialCfgSourceName =  "yardCfgSource" 

     let rulesToGraph rules = 
       let initial = 
	 {
	  name  = initialCfgSourceName;
	  param = None;
	  body  = 
	   { 
	     emptyRule with  
	     tree = AltBlock (List.map (fun r -> {emptyRule with tree = RuleRef (r.name,None)}) rules)
	   }
	} 
       in
       let onlyNodes =
	 List.fold_left 
	   (fun graph rule -> fst (D.insertNode graph rule)) 
	   (D.create ()) 
	   (initial :: rules) 
       in
       let nodesList = D.nodes onlyNodes in
       let outNodes node = 
         let rec loop rule = match rule.tree with
         | AltBlock lst | SeqBlock (lst, _) ->  List.fold_left NameSet.union NameSet.empty (List.map loop lst)
         | Iterated (r,_) -> loop r
         | RuleRef (name,_) -> NameSet.singleton name
         | _ -> NameSet.empty
         in 
	 List.fold_left 
	   (fun l name -> 
	     try 
	       List.find 
		 (fun node -> (D.Node.info node).name = name) nodesList :: l
	     with Not_found -> l
	   ) 
	   []
           (NameSet.elements (loop (D.Node.info node).body))
       in    
       List.fold_left 
         (fun g node-> 
           (List.fold_left 
              (fun g toNode -> 
                fst (D.insertEdge g node toNode (D.Node.toString node, D.Node.toString toNode))
              ) g (outNodes node)
           )
         ) 
	 onlyNodes 
	 nodesList

    let toString g = D.toDOT g.rules

    let src g = List.find (fun node -> (D.Node.info node).name = initialCfgSourceName) (D.nodes g) 
    let gramBySCCs g = 

      let graph = rulesToGraph g.rules in
      let start = src graph in

      let module DFST = DFST.Make(D)(struct let graph = graph let start = start end) in
      let module DOM = Dominance.Make (DFST) in
      let module LOOPS = Loops.Make(DOM) in

      let sccs = List.map (fun x -> List.map D.Node.info (snd x)) (LOOPS.Region.SCC.get ()) in

      let filteredSCCs = 
	List.filter (function [x] -> x.name <> initialCfgSourceName | _ -> true) sccs 
      in
      {head=g.head; foot=g.foot; rules=filteredSCCs}

   end
				       
   let toSCCs = GramAsDi.gramBySCCs
   
end

*)